home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1993 December
/
PSL Monthly Shareware CD-ROM (December 1993).iso
/
prgmming
/
dos
/
basic
/
hirescol.bas
< prev
next >
Wrap
BASIC Source File
|
1984-03-05
|
5KB
|
135 lines
1000 SCREEN 2 : KEY OFF : CLS
1010 PRINT " 640 x 200 Black & White Graphics Mode Demonstration"
1020 PRINT
1030 PRINT
1040 PRINT " ************* I N F U L L C O L O R *************"
1050 PRINT
1060 PRINT " Technique discovered by: JAMES L JOHNSEN"
1070 PRINT
1080 PRINT " and implemented through a program originally written for the 320 x 200"
1090 PRINT "graphics mode by: MICRO-G, P.O. BOX 102, DULUTH, GEORGIA 30136, (404) 476-5779"
1100 PRINT
1110 PRINT " Just look at the letters (left edge and top) to see that we're in 640 x 200."
1130 PRINT
1140 PRINT
1150 LOCATE 13,24 :PRINT " USE CURSOR KEYS TO CHANGE COLORS"
1160 LOCATE 15,23 :PRINT " PRESS THE <ESC> KEY FOR COLOR DEMO"
1180 CLS : OUT (984),14
1190 KEY(11) ON :KEY(12) ON
1200 KEY(13) ON :KEY(14) ON
1210 ON KEY(11) GOSUB 1350
1220 ON KEY(12) GOSUB 1380
1230 ON KEY(13) GOSUB 1390
1240 ON KEY(14) GOSUB 1420
1250 CLS
1260 BACK=7
1270 OUT (985),16
1280 GOSUB 1450
1290 GOSUB 1520
1300 LOCATE 25,1:PRINT SPC(79);
1310 LOCATE 25,15:PRINT "BACKGROUND ";BACK;
1320 LOCATE 25,60:PRINT "PALATE ";PALATE / 16 - 1;
1330 QUIT$ = INKEY$ : IF QUIT$ = CHR$(27) THEN CLS: GOTO 2000
1340 GOTO 1310
1350 BACK=BACK+1: IF BACK=>32 THEN BACK=0
1360 OUT (985),BACK+PALATE
1370 RETURN
1380 GOTO 1390
1390 PALATE =PALATE+16 :IF PALATE > 32 THEN PALATE=16
1400 OUT (985),BACK+PALATE
1410 RETURN
1420 BACK=BACK-1: IF BACK<0 THEN BACK=31
1430 OUT (985),BACK+PALATE
1440 RETURN
1450 REM PRINT THE NUMBERS
1460 LOCATE 3,1 :PRINT " 0 1 2 3 0 1 2 3"
1470 LOCATE 8,1 :PRINT "0"
1480 LOCATE 13,1 :PRINT "1"
1490 LOCATE 18,1 :PRINT "2"
1500 LOCATE 23,1 :PRINT "3"
1510 RETURN
1520 V=40
1530 H=60 :AA=0 :BB=0 :GOSUB 1740
1540 H=120 :AA=0 :BB=1 :GOSUB 1740
1550 H=180 :AA=0 :BB=2 :GOSUB 1740
1560 H=240:AA=0 :BB=3 :GOSUB 1740
1570 V=80
1580 H=60 :AA=1 :BB=0 :GOSUB 1740
1590 H=120 :AA=1 :BB=1 :GOSUB 1740
1600 H=180:AA=1 :BB=2 :GOSUB 1740
1610 H=240:AA=1 :BB=3 :GOSUB 1740
1620 V=120
1630 H=60 :AA=2 :BB=0 :GOSUB 1740
1640 H=120:AA=2 :BB=1 :GOSUB 1740
1650 H=180:AA=2 :BB=2 :GOSUB 1740
1660 H=240:AA=2 :BB=3 :GOSUB 1740
1670 V=160
1680 H=60 :AA=3 :BB=0 :GOSUB 1740
1690 H=120:AA=3 :BB=1 :GOSUB 1740
1700 H=180:AA=3 :BB=2 :GOSUB 1740
1710 H=240:AA=3 :BB=3 :GOSUB 1740
1720 LOCATE 25,1 :PRINT SPC(79);
1730 RETURN
1740 REM DRAW BOXES TWICE CHANGE ORDER OF COLLOR
1750 FOR B=0 TO 60 STEP 2
1760 LINE((H+B),(V+40))-((H+B),(V)),AA
1770 LINE((H+B+1),(V+40))-((H+B+1),(V)),BB
1780 NEXT B
1790 H=H+320
1800 FOR B=0 TO 60 STEP 2
1810 LINE((H+B),(V+40))-((H+B),(V)),BB
1820 LINE((H+B+1),(V+40))-((H+B+1),(V)),AA
1830 NEXT B
1840 H=H-320
1850 RETURN
2000 OUT (984),30 : OUT (985),15
2010 PRINT " 640 x 200 Black & White Graphics Mode Demonstration"
2020 PRINT
2030 PRINT
2040 PRINT " ************* I N F U L L C O L O R *************"
2050 PRINT
2060 PRINT " Technique discovered by: JAMES L JOHNSEN"
2070 PRINT
2080 PRINT " T H E D A Z Z Z L E R Written by James L. Johnsen"
2090 PRINT
2100 PRINT " 402 Beech Street, Fort Washington, Maryland. 20744 (h) (301) 292-7169"
2110 FOR PAUSE = 1 TO 15000 : NEXT PAUSE
2120 PRINT
2130 PRINT
2140 LOCATE 14,26 :PRINT " PRESS THE <ESC> KEY TO QUIT"
2150 FOR I=0 TO 7000:NEXT I
2160 OUT (984),14:CLS:DIM T1%(70),T2%(70),Q1%(70),Q2%(70)
2170 V%=5:X2%=639:H=.5:Y2%=13:X1%=37:Y1%=199:C1=1:WHEREAT%=1:S%=350
2180 DEF SEG = &H40:X% = PEEK(&H6C) : DEF SEG
2190 RANDOMIZE X%
2200 L1% = T1%(WHEREAT%) : J1% = Q1%(WHEREAT%) : L2% = T2%(WHEREAT%) : J2% = Q2%(WHEREAT%)
2210 LINE (L1%,J1%)-(L2%,J2%),0
2220 IF C1 > 0 THEN 2290
2230 C1 = RND (X%) * S% : OUT (985),COLORVAL
2240 X3% = - V% : X4% = - V% : Y3% = - V% : Y4% = - V%
2250 IF RND(Y) > H THEN X3% = V%
2260 IF RND(X%) > H THEN X4% = V%
2270 IF RND(X%) > H THEN Y3% = V%
2280 IF RND(X%) > H THEN Y4% = V%
2290 X1% = X1% + X3%
2300 IF X1% < 1 OR X1% > 639 THEN X3% = - X3% : GOTO 2290
2310 T1% (WHEREAT%) = X1%
2320 X2% = X2% + X4%
2330 IF X2% < 1 OR X2% > 639 THEN X4% = - X4% : GOTO 2320
2340 T2%(WHEREAT%) = X2%
2350 Y1% = Y1% + Y3%
2360 IF Y1% < 1 OR Y1% > 199 THEN Y3% = - Y3% : GOTO 2350
2370 Q1%(WHEREAT%)=Y1%
2380 Y2% = Y2% + Y4%
2390 IF Y2% < 1 OR Y2% > 199 THEN Y4% = - Y4% : GOTO 2380
2400 Q2% (WHEREAT%) = Y2%
2410 L1% = T1%(WHEREAT%) : J1% = Q1%(WHEREAT%) : L2% = T2%(WHEREAT%) : J2% = Q2%(WHEREAT%)
2420 LINE (L1%,J1%)-(L2%,J2%),1
2430 WHEREAT% = WHEREAT% + 1
2440 IF WHEREAT% >= 70 THEN WHEREAT% = 1
2450 C1 = C1 - 1
2460 COLORVAL = COLORVAL + 1 : IF COLORVAL > = 64 THEN COLORVAL = 1
2470 QUITT$ = INKEY$ : IF QUITT$ = "" THEN GOTO 2180
2480 CLS: SCREEN 0,0,0 : WIDTH 80:COLOR 15,0,0:CLS
2490 END 'SYSTEM